home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok40.lha / DoubleBuffering / Chemie.mod < prev    next >
Text File  |  1993-08-15  |  8KB  |  291 lines
  1. (***************************************************************************
  2.   :Program.       Chemie.mod
  3.   :Author.        Jürgen Zimmermann
  4.   :Address.       Ringstraße 6, 6719 Altleiningen, West-Germany
  5.   :Phone.         06356/1456
  6.   :ShortCut.      [JnZ]
  7.   :Support.       -
  8.   :Version.       1.61
  9.   :Date.          1. November 1989
  10.   :Copyright.     PD
  11.   :Language.      MODULA-II
  12.   :Translator.    M2Amiga 3.3d
  13.   :Contents.      Demoprogramm für Modul "DoubleBuffering"
  14.   :Remark.        Ich würde mich sehr über Kontakt mit anderen M2Amiga-Usern
  15.   :Remark.        und MIDI-Freaks freuen.
  16.   :Usage.         Nur starten.
  17. ****************************************************************************)
  18.  
  19. MODULE Chemie; (* Version 1.61 from 1th November, 1989 *)
  20.  
  21. (*(* $R- $S- $N- $F- *)*)
  22.  
  23. FROM DoubleBuffering IMPORT OpenDoubleView, CloseDoubleView, SwapBuffers,
  24.                             CleanDrawBuffer, GetDrawRastPort;
  25.  
  26. FROM SYSTEM    IMPORT ADR, ADDRESS, BITSET;
  27.  
  28. (* FROM InOut     IMPORT WriteLn, WriteString, WriteInt; *)
  29.  
  30. (* FROM RealInOut IMPORT ReadReal, WriteReal; *)
  31.  
  32. FROM Graphics  IMPORT SetAPen, SetDrMd, RectFill, jam1, Move, DrawModes,
  33.                       DrawModeSet, ViewModeSet, ViewModes, RastPort,
  34.                       RastPortPtr, SetRGB4, GfxBase, GfxBasePtr, View, ViewPtr,
  35.                       ViewPort,ViewPortPtr,AllocRaster, MrgCop,MakeVPort,
  36.                       InitBitMap, LoadView, InitRastPort, WaitTOF, GetColorMap,
  37.                       FreeColorMap,FreeRaster,FreeVPortCopLists,FreeCprList,
  38.                       BitMap, BitMapPtr, RasInfo, CprlistPtr, Cprlist,
  39.                       InitVPort, InitView;
  40.  
  41. FROM Dos IMPORT Delay;
  42.  
  43. IMPORT Graphics;
  44.  
  45.  
  46. FROM Arts IMPORT TermProcedure, Assert, RemoveTermProc;
  47.  
  48.  
  49. CONST breite=320;
  50.       hoehe=256;
  51.  
  52.  
  53. VAR DeltaProdukt: REAL; (* Für Abbruch!!! *)
  54.  
  55.  
  56. CONST Gefaessbreite = 200.0;
  57.       Gefaesshoehemax = 230.0;
  58.  
  59.  
  60. VAR Edukt1Hoehe: REAL;
  61.     Edukt2Hoehe: REAL;
  62.     ProduktHoehe: REAL;
  63.  
  64.     Edukt1Rohr : REAL;
  65.     Edukt2Rohr : REAL;
  66.     ProduktRohr: REAL;
  67.  
  68.     Edukt1GesamtVolumen: REAL;
  69.     Edukt2GesamtVolumen: REAL;
  70.     ProduktGesamtVolumen: REAL;
  71.  
  72.     Edukt1Faktor: REAL;
  73.     Edukt2Faktor: REAL;
  74.  
  75.  
  76. PROCEDURE Initialisieren;
  77.  
  78.    BEGIN
  79.       Edukt1GesamtVolumen:=Edukt1Hoehe*Gefaessbreite;
  80.       Edukt2GesamtVolumen:=Edukt2Hoehe*Gefaessbreite;
  81.       ProduktGesamtVolumen:=ProduktHoehe*Gefaessbreite;
  82.    END Initialisieren;
  83.  
  84.  
  85. PROCEDURE Eingabe;
  86.  
  87.    BEGIN
  88. (*      WriteString("Höhe Edukt1? ");
  89.       ReadReal(Edukt1Hoehe);
  90.       WriteLn;
  91.       WriteString("Höhe Edukt2? ");
  92.       ReadReal(Edukt2Hoehe);
  93.       WriteLn;
  94.       WriteString("Höhe Produkt? ");
  95.       ReadReal(ProduktHoehe);
  96.       WriteLn;
  97.       WriteString("Reaktionsfaktor Edukt1? ");
  98.       ReadReal(Edukt1Faktor);
  99.       WriteLn;
  100.       WriteString("Reaktionsfaktor Edukt2? ");
  101.       ReadReal(Edukt2Faktor);
  102.       WriteLn;
  103.       WriteString("Breite Rohr Edukt1? ");
  104.       ReadReal(Edukt1Rohr);
  105.       WriteLn;
  106.       WriteString("Breite Rohr Edukt2? ");
  107.       ReadReal(Edukt2Rohr);
  108.       WriteLn;
  109.       WriteString("Breite Rohr Produkt? ");
  110.       ReadReal(ProduktRohr);
  111.       WriteLn;
  112. *)
  113.       Edukt1Hoehe :=50.0;
  114.       Edukt2Hoehe :=150.0;
  115.       ProduktHoehe:=40.0;
  116.  
  117.       Edukt1Rohr :=1.0;
  118.       Edukt2Rohr :=4.0;
  119.       ProduktRohr:=2.5;
  120.  
  121.       Edukt1Faktor:=1.0;
  122.       Edukt2Faktor:=3.0;
  123.    END Eingabe;
  124.  
  125.  
  126. (* PROCEDURE Ausgabe;
  127.  
  128.    BEGIN
  129.       WriteString("Edukt1: ");
  130.       WriteReal(Edukt1Hoehe,10,7);
  131.       WriteString(", Edukt2: ");
  132.       WriteReal(Edukt2Hoehe,10,7);
  133.       WriteString(", Produkt: ");
  134.       WriteReal(ProduktHoehe,10,7);
  135.       WriteLn;
  136.    END Ausgabe; *)
  137.  
  138.  
  139. PROCEDURE SyntheseAnalyse;
  140.  
  141.    VAR Edukt1Analyse: REAL;
  142.        Edukt2Analyse: REAL;
  143.        ProduktSynthese: REAL;
  144.  
  145.        Edukt1RueckVolumen: REAL;
  146.        Edukt2RueckVolumen: REAL;
  147.  
  148.        Edukt1RohrVolumen: REAL;
  149.        Edukt2RohrVolumen: REAL;
  150.        ProduktRohrVolumen: REAL;
  151.  
  152.        Edukt1VolumenNeu: REAL;
  153.        Edukt2VolumenNeu: REAL;
  154.        ProduktVolumenNeu: REAL;
  155.  
  156.        Gesamtfaktor: REAL;
  157.        Faktorenquotient: REAL;
  158.        Volumenquotient: REAL;
  159.  
  160.    BEGIN
  161.  
  162.       Gesamtfaktor:=Edukt1Faktor+Edukt2Faktor;
  163.  
  164.  
  165.       Edukt1RohrVolumen:=Edukt1Hoehe*Edukt1Rohr; (* Volumina der Flüssigkeiten*)
  166.       Edukt2RohrVolumen:=Edukt2Hoehe*Edukt2Rohr; (* in den Rohren ausrechnen *)
  167.       ProduktRohrVolumen:=ProduktHoehe*ProduktRohr;
  168.  
  169.       DeltaProdukt:=ProduktGesamtVolumen;
  170.  
  171.       Edukt1VolumenNeu:=Edukt1GesamtVolumen-Edukt1RohrVolumen; (* "Rohrvolumen " *)
  172.       Edukt2VolumenNeu:=Edukt2GesamtVolumen-Edukt2RohrVolumen; (* subtrahieren *)
  173.       ProduktVolumenNeu:=ProduktGesamtVolumen-ProduktRohrVolumen;
  174.  
  175.  
  176.       Edukt1Analyse:=(ProduktRohrVolumen*Edukt1Faktor)/Gesamtfaktor;
  177.       Edukt2Analyse:=(ProduktRohrVolumen*Edukt2Faktor)/Gesamtfaktor;
  178.       (* Volumen, die aus der Analyse des Produktes entstehen. *)
  179.  
  180.       Edukt1VolumenNeu:=Edukt1VolumenNeu+Edukt1Analyse;
  181.       Edukt2VolumenNeu:=Edukt2VolumenNeu+Edukt2Analyse;
  182.  
  183.  
  184.       Edukt1RueckVolumen:=0.0;
  185.       Edukt2RueckVolumen:=0.0;
  186.  
  187.       Faktorenquotient:=Edukt1Faktor/Edukt2Faktor;
  188.       Volumenquotient:=Edukt1RohrVolumen/Edukt2RohrVolumen;
  189.  
  190.       IF (Faktorenquotient # Volumenquotient)
  191.          THEN
  192.             IF (Faktorenquotient > Volumenquotient)
  193.                THEN  (* zuviel Edukt2!!! *)
  194.                   Edukt2RueckVolumen:=Edukt2RohrVolumen-((Edukt1RohrVolumen/
  195.                                       Edukt1Faktor)*Edukt2Faktor);
  196.  
  197.                ELSE  (* zuviel Edukt1!!! *)
  198.                   Edukt1RueckVolumen:=Edukt1RohrVolumen-((Edukt2RohrVolumen/
  199.                                       Edukt2Faktor)*Edukt1Faktor);
  200.  
  201.             END; (* IF *)
  202.  
  203.       END; (* IF *)
  204.  
  205.       Edukt1RohrVolumen:=Edukt1RohrVolumen-Edukt1RueckVolumen;
  206.       Edukt2RohrVolumen:=Edukt2RohrVolumen-Edukt2RueckVolumen;
  207.  
  208.       Edukt1VolumenNeu:=Edukt1VolumenNeu+Edukt1RueckVolumen;
  209.       Edukt2VolumenNeu:=Edukt2VolumenNeu+Edukt2RueckVolumen;
  210.  
  211.  
  212.       ProduktSynthese:=Edukt1RohrVolumen+Edukt2RohrVolumen;
  213.  
  214.       ProduktVolumenNeu:=ProduktVolumenNeu+ProduktSynthese;
  215.  
  216.  
  217.       Edukt1GesamtVolumen:=Edukt1VolumenNeu;
  218.       Edukt2GesamtVolumen:=Edukt2VolumenNeu;
  219.       ProduktGesamtVolumen:=ProduktVolumenNeu;
  220.  
  221.       DeltaProdukt:=DeltaProdukt-ProduktVolumenNeu;
  222.  
  223.       Edukt1Hoehe:=Edukt1GesamtVolumen/Gefaessbreite;
  224.       Edukt2Hoehe:=Edukt2GesamtVolumen/Gefaessbreite;
  225.       ProduktHoehe:=ProduktGesamtVolumen/Gefaessbreite;
  226.  
  227.    END SyntheseAnalyse;
  228.  
  229.  
  230. PROCEDURE InitScreen;
  231.  
  232.    BEGIN
  233.       OpenDoubleView(0,0,320,256,3,ViewModeSet{});
  234.    END InitScreen;
  235.  
  236.  
  237. PROCEDURE Block (Raster: RastPortPtr;
  238.                  Color, xstart, ystart, xend, yend: INTEGER);
  239.  
  240.    BEGIN
  241.       SetAPen (Raster, Color);
  242.       SetDrMd (Raster, jam1);
  243.       RectFill (Raster, xstart, ystart, xend, yend);
  244.    END Block;
  245.  
  246.  
  247. PROCEDURE Zeichnen;
  248.  
  249.    VAR RP: RastPortPtr;
  250.        x: REAL;
  251.  
  252.    BEGIN
  253.       x:=(REAL(breite)/640.0);
  254.       RP:=GetDrawRastPort();
  255.       Block(RP,0,0,0,breite-1,hoehe-1); (* Bitmap löschen *)
  256.  
  257.       Block(RP,2,1,(hoehe-TRUNC(Edukt1Hoehe)-1),TRUNC(200.0*x),hoehe-1);
  258.       Block(RP,3,TRUNC(211.0*x),(hoehe-TRUNC(Edukt2Hoehe)-1),
  259.             TRUNC(410.0*x),hoehe-1);
  260.       Block(RP,4,TRUNC(421.0*x),(hoehe-TRUNC(ProduktHoehe)-1),
  261.             TRUNC(620.0*x),hoehe-1);
  262.       SwapBuffers;
  263.    END Zeichnen;
  264.  
  265.  
  266. PROCEDURE CloseAll;
  267.  
  268.    BEGIN
  269.       CloseDoubleView;
  270.    END CloseAll;
  271.  
  272.  
  273. BEGIN
  274.    TermProcedure(CloseAll);
  275.    Eingabe;
  276.    Initialisieren;
  277.    InitScreen;
  278.    LOOP
  279.       SyntheseAnalyse;
  280.      (* Ausgabe; *)
  281.       Zeichnen;
  282.       IF (TRUNC(DeltaProdukt)=0)
  283.          THEN
  284.             Delay(500);
  285.             EXIT;
  286.       END; (* IF *)
  287.    END; (* LOOP *)
  288.    RemoveTermProc(CloseAll);
  289.    CloseAll;
  290. END Chemie.
  291.